unit Macros;

interface

uses
  Classes, StdCtrls, KbrdTools;

const
  CharCaret = '^';

type
  TMacro = record
    Tecla : TKey;
    Texto : string;
  end;

  TManejadorMacros = class;

  TEventoCambioMacro = procedure(Sender:TManejadorMacros; M:TMacro) of object;

  TManejadorMacros = class
  private
    FMacros : TStringList;
    function IndexOfTecla(Tecla: TKey): Integer;
    function GetCantidadMacros: Integer;
    function GetMacro(index: Integer): TMacro;
    procedure CambioMacro(M:TMacro);
  public
    AlCambiarMacro : TEventoCambioMacro;
    EnviarTeclas : boolean;
    procedure BorrarMacros;
    property CantidadMacros:Integer read GetCantidadMacros;
    property Macro[index:Integer]:TMacro read GetMacro;
    procedure AgregarMacro(Tecla:TKey; const Texto:string); overload;
    procedure AgregarMacro(const M:TMacro); overload;
    procedure AgregarMacroDeString(s:string);
    procedure AgregarMacrosDeString(s:string);
    procedure AgregarMacrosDeStrings( t:TStrings);
    procedure MacrosToStrings(t:TStrings);
    function MacrosToString:string;
    procedure EliminarMacro(Tecla:TKey);
    function TextoDeTecla(Tecla:TKey):string;
    function CaretPosDeTecla(Tecla:TKey):Integer;
    function MacroDeTecla(Tecla:TKey):TMacro;
    function ExisteMacroDeTecla(Tecla:TKey):Boolean;
    function TeclaPresionada(e:TEdit;T:TKey):Boolean; overload;
    function TeclaPresionada(e:TMemo;T:TKey):Boolean; overload;
    constructor Create;
    destructor Destroy; override;
  end;

  function Macro(T:TKey; const Texto:string):TMacro;
  function MacroToStr(const M:TMacro):string;
  function StrToMacro(s:string):TMacro;

  procedure InsertarTextoEnEdit(const texto:string; e: TEdit);

implementation

uses
  Windows, StrTools;

function PosicionCaret(const texto:string):Integer;
begin
  for result:= 1 to length(texto) do
    if texto[result]=CharCaret then
      if (result=length(texto)) or (texto[result+1]<>CharCaret) then exit;
  result := 0;
end;

function TextoSinCaret(const texto:string):string;
  var i:Integer;
begin
  i := PosicionCaret(texto);
  if i=0 then
    result := texto
  else
    result := Copy(texto,1,i-1)+Copy(texto,i+1,length(texto));
end;

procedure InsertarTextoEnEdit(const texto:string; e: TEdit);
  var i,k,l:Integer; s,u:string; n:TNotifyEvent;
begin
  k := e.SelStart;
  l := e.SelLength;
  u := TextoSinCaret(texto);
  s := Copy(e.Text,1,k)+u+Copy(e.Text,k+l+1,length(e.Text));
  i := PosicionCaret(texto);
  if i=0 then i := length(u) + 1;
  n := e.OnChange;
  e.OnChange := nil;
  e.Text := s;
  e.SelStart := k+i-1;
  e.OnChange := n;
  if Assigned(n) then n(e);
end;

procedure InsertarTextoEnMemo(const texto:string; e: TMemo);
  var i,k,l:Integer; s,u:string; n:TNotifyEvent;
begin
  k := e.SelStart;
  l := e.SelLength;
  u := TextoSinCaret(texto);
  s := Copy(e.Text,1,k)+u+Copy(e.Text,k+l+1,length(e.Text));
  i := PosicionCaret(texto);
  if i=0 then i := length(u) + 1;
  n := e.OnChange;
  e.OnChange := nil;
  e.Text := s;
  e.SelStart := k+i-1;
  e.OnChange := n;
  if Assigned(n) then n(e);
end;

procedure EnviarTextoAEdit(const texto:string; e: TEdit);
var
  u : string;
  n : TNotifyEvent;
  h : THandle;
begin
  u := TextoSinCaret(texto);
  n := e.OnChange;
  h := GetFocus;
  e.OnChange := nil;
  SetFocus(e.Handle);
  SendKeys(u);
  e.OnChange := n;
  if Assigned(n) then n(e);
  SetFocus(h);
end;

procedure EnviarTextoAMemo(const texto:string; e: TMemo);
var
  u : string;
  n : TNotifyEvent;
  h : THandle;
begin
  u := TextoSinCaret(texto);
  n := e.OnChange;
  h := GetFocus;
  e.OnChange := nil;
  SetFocus(e.Handle);
  SendKeys(u);
  e.OnChange := n;
  if Assigned(n) then n(e);
  SetFocus(h);
end;

function Macro(T:TKey; const Texto:string):TMacro;
begin
  result.Tecla := T;
  result.Texto := Texto;
end;

function MacroToStr(const M:TMacro):string;
begin
  result := '(' + KeyToStr(M.Tecla)+','+M.Texto + ')';
end;

function StrToMacro(s:string):TMacro;
begin
  if (s<>'') and (s[1]='(') then
    if s[length(s)]=')' then
      s := Copy(s,2,length(s)-2)
    else
      s := Copy(s,2,length(s));
  result.Tecla := StrToKey(GetParam(',',s));
  result.Texto := s;
end;

{ TManejadorMacros }

constructor TManejadorMacros.Create;
begin
  inherited;
  FMacros := TStringList.Create;
end;

destructor TManejadorMacros.Destroy;
begin
  FMacros.Free;
  inherited;
end;

procedure TManejadorMacros.AgregarMacro(Tecla: TKey; const Texto: string);
  var i:Integer;
begin
  if Texto = '' then exit;
  with FMacros do
  begin
    i := IndexOfTecla(Tecla);
    if i<0 then
      AddObject(Texto, KeyToPtr(Tecla))
    else
    begin
      if Strings[i] = Texto then exit;
      Strings[i] := Texto;
    end;
  end;
  CambioMacro(Macros.Macro(Tecla,Texto));
end;

procedure TManejadorMacros.EliminarMacro(Tecla: TKey);
  var i:Integer;
begin
  with FMacros do
  begin
    i := IndexOfTecla(Tecla);
    if i<0 then exit;
    delete(i);
    CambioMacro(Macros.Macro(Tecla,''));
  end;
end;

function TManejadorMacros.MacroDeTecla(Tecla: TKey): TMacro;
  var i:Integer;
begin
  with FMacros do
  begin
    i := IndexOfTecla(Tecla);
    if i<0 then
      result := Macros.Macro(Tecla,'')
    else
      result := Macros.Macro(Tecla,Strings[i]);
  end;
end;

function TManejadorMacros.TextoDeTecla(Tecla: TKey): string;
begin
  result := TextoSinCaret(MacroDeTecla(Tecla).Texto);
end;

function TManejadorMacros.CaretPosDeTecla(Tecla: TKey): Integer;
begin
  result := PosicionCaret(MacroDeTecla(Tecla).Texto);
end;

procedure TManejadorMacros.AgregarMacro(const M: TMacro);
begin
  AgregarMacro(M.Tecla,M.Texto);
end;

procedure TManejadorMacros.AgregarMacroDeString(s: string);
begin
  AgregarMacro(StrToMacro(s));
end;

procedure TManejadorMacros.AgregarMacrosDeString( s: string);
begin
  while s<>'' do
    AgregarMacroDeString(GetParam(',',s,[poSkipParentheses]));
end;

procedure TManejadorMacros.AgregarMacrosDeStrings(t: TStrings);
  var i:Integer;
begin
  for i:=0 to t.Count-1 do
    AgregarMacroDeString(t[i]);
end;

function TManejadorMacros.TeclaPresionada(e: TEdit; T: TKey):boolean;
  var i:Integer;
begin
  i := IndexOfTecla(T);
  result := i>=0;
  if result then
  begin
    if EnviarTeclas then EnviarTextoAEdit(FMacros[i],e)
                    else InsertarTextoEnEdit(FMacros[i],e);
  end;
end;

function TManejadorMacros.TeclaPresionada(e: TMemo; T: TKey):boolean;
  var i:Integer;
begin
  i := IndexOfTecla(T);
  result := i>=0;
  if result then
  begin
    if EnviarTeclas then EnviarTextoAMemo(FMacros[i],e)
                    else InsertarTextoEnMemo(FMacros[i],e);
  end;
end;

function TManejadorMacros.IndexOfTecla(Tecla: TKey): Integer;
begin
  result := FMacros.indexOfObject(KeyToPtr(Tecla));
end;

function TManejadorMacros.ExisteMacroDeTecla(Tecla: TKey):boolean;
begin
  result := IndexOfTecla(Tecla)>=0;
end;

function TManejadorMacros.GetCantidadMacros: Integer;
begin
 result := FMacros.Count;
end;

function TManejadorMacros.GetMacro(index: Integer): TMacro;
begin
  if (index<0) or (index>=FMacros.Count) then
  begin
    result.Tecla := NullKey;
    result.Texto := '';
  end
  else
  begin
    result.Tecla := PtrToKey(FMacros.Objects[index]);
    result.Texto := FMacros[index];
  end;
end;

function TManejadorMacros.MacrosToString: string;
  var i:Integer;
begin
  result := '';
  with FMacros do
  for i:=0 to Count-1 do
  begin
    if result<>'' then result := result + ',';
    result := result + MacroToStr(Macro[i]);
  end
end;

procedure TManejadorMacros.MacrosToStrings(t: TStrings);
  var i:Integer;
begin
  with FMacros do
  for i:=0 to Count-1 do
    t.Add(MacroToStr(Macro[i]));
end;

procedure TManejadorMacros.CambioMacro(M: TMacro);
begin
  if Assigned(AlCambiarMacro) then AlCambiarMacro(self,M);
end;

procedure TManejadorMacros.BorrarMacros;
begin
  FMacros.Clear;
end;

end.
